home *** CD-ROM | disk | FTP | other *** search
/ Your Choice 3 / Your Choice Software Collection 3.iso / prgmming / qbasic / roseqbas.bas < prev    next >
BASIC Source File  |  1993-10-12  |  24KB  |  525 lines
  1. '
  2. ' ROSEWOOD QUICKBASIC STUFF v 1 consists of two programs which can be
  3. ' incorporated into programs written in QuickBasic 4.xx or QBasic which
  4. ' is supplied with MS DOS 5 and 6. Libraries or commands such as
  5. ' CALL INTERRUPT not used in QBasic are not needed with this code.
  6. '
  7. ' There are two distinct parts of the program:
  8. '
  9. '   The first is an input editor which will replace the commands "INPUT",
  10. ' "LINE INPUT", etc. with an input routine written with INKEY$ as the input.
  11. ' INKEY$ allows much nicer inputting, especially if you have several inputs
  12. ' to process in succession. This editor can be set up to accept various types
  13. ' of input and to block other types. This will greatly reduce the amount of
  14. ' error checking which is associated with the usual input functions.
  15. '   Some parts of this program may look ancient with its IF..ENDs and GOTOs.
  16. ' However, I like to have the ability to cascade through the editor. See
  17. ' how scan% = 8 becomes scan% = 83 in the backspace command area. The program
  18. ' could be written using only DO..LOOP, SELECT CASE etc. but I doubt that it
  19. ' would make the program work better. It would be prettier though.
  20. ' The editor is very loosely based on a program from the magazine,
  21. ' PC RESOURCES, October 1987, pg. 61
  22. '
  23. '   The second part of the code is a simple window program. Windows of any
  24. ' size or colour, with or without a border, can be placed anywhere on the
  25. ' screen with text justified left, centre and right, and then wiped off so
  26. ' that the original screen below is restored. The speed in drawing and
  27. ' erasing these windows is not as great as windows using registers and
  28. ' CALL ABSOLUTE, but it is adequate for most purposes.
  29.  
  30. ' This code is written by:      Bert Christensen
  31. '                               Rosewood Software
  32. '                               135-10 Livonia Place
  33. '                               Scarborough, Ontario, Canada M1E 4W6
  34. '                               (416) 284-6119, CompuServe 70461,2507
  35. '                               Internet bert.christensen@canrem.com
  36. '
  37. '                               Copyright (c) 1993 by Bert Christensen
  38. '
  39. ' Anyone is granted full permission to use all or part of this program
  40. ' without charge. However, if you should feel moved to send a donation,
  41. ' it will not be refused.
  42. '
  43. ' Any comments would be appreciated.
  44. '
  45. '
  46. '           ROSEWOOD QUICKBASIC STUFF v 1
  47. '
  48. '           Programmed in MicroSoft QuickBasic 4.5 and VisualBasic for DOS 1.00
  49. '           October 1993
  50. '
  51. '
  52. '        ******DECLARATIONS*****
  53.  
  54. DECLARE SUB Fulledit (row%(), column%(), numentry%, inperr%(), item$(), itemlen%(), itemflag%())
  55. DECLARE SUB WindowSub (wintop%, winbot%, winleft%, winright%, winforecolour%, winbackcolour%, wintext$(), winborder%)
  56. DECLARE FUNCTION Justify$ (text$, just%, winleft%, winright%)
  57. DECLARE SUB Frame (toprow%, bottomrow%, leftcol%, rightcol%)
  58. COMMON SHARED /colours/ sfg%, sbg%, rfg%, rbg%, ffg%, fbg%
  59. sfg% = 0        'standard foreground
  60. sbg% = 7        'standard background
  61. rfg% = 7        'reverse foreground
  62. rbg% = 1        'reverse background
  63. REM ffg% = frame foreground
  64. REM fbg% = frame background
  65.  
  66.  
  67. REM ******************EDITOR SECTION**********************
  68.  
  69. LOCATE 1, 1     'goto top left so whole screen will be "coloured"
  70. COLOR sfg%, sbg%
  71. CLS
  72. COLOR rfg%, rbg%
  73. ' place prompts on the screen
  74. LOCATE 1, 12: PRINT "`Rosewood QB Stuff' Input Editor for QuickBasic & QBasic"
  75. COLOR sfg%, sbg%
  76. LOCATE 3, 5: PRINT "This field accepts 0 to 9 & space only"; : LOCATE 5, 5: PRINT "This field accepts all alphanumeric entries";
  77. LOCATE 7, 5: PRINT "This field accepts `0' to `9',`-', `.' and `space' only"; : LOCATE 9, 5: PRINT "The Esc key is disabled in this field";
  78. LOCATE 11, 5: PRINT "Edit pre-existing data"; : LOCATE 13, 5: PRINT "Field length of 1"; :   LOCATE 15, 5: PRINT "Field length of 45";
  79. LOCATE 17, 27: PRINT "Fields can be placed anywhere on screen"
  80. LOCATE 19, 1: PRINT STRING$(80, "*");
  81. LOCATE 20, 5: PRINT "Use arrow keys, Home, End, PgUp, PgDn, Del, Bksp, Ins to edit";
  82. LOCATE 21, 5: PRINT "Ctrl F3 to delete input; Ctrl F4 to copy text; Ctrl F5 to paste";
  83. LOCATE 22, 5: PRINT "Ctrl End & Ctrl Home to move to ends of field; Ctrl F10 to quit editing";
  84. LOCATE 23, 5: PRINT "Ctrl F6 to centre text";
  85. entryload$ = "Bert Christensen, Rosewood Software"      'see item$(5) below
  86. numentry% = 8   'number of input items. can be 1 to ??
  87.  
  88. REDIM item$(numentry%), itemlen%(numentry%), inperr%(numentry%), row%(numentry%), column%(numentry%), itemflag%(numentry%)
  89.  
  90. 'item$() = the input item. if there is data to be edited, see below at item$(5).
  91. 'if there is no data to be edited then item$() = " ".
  92. 'itemlen%() = the length of the item$().
  93. 'inperr%() is a flag to manipulate data in the sub, Fulledit
  94. 'column%() is the horizontal column position to start the editing of the particular item$()
  95. 'row%() is the vertical row to start editing the item$()
  96. 'itemflag%() is like inperr%() above (in case you should need 2)
  97. 'below is the filling of the arrray
  98.  
  99.         item$(1) = " ": itemlen%(1) = 5: inperr%(1) = 0: column%(1) = 44: row%(1) = 3: itemflag%(1) = 1
  100.         item$(2) = " ": itemlen%(2) = 25: inperr%(2) = 0: column%(2) = 50: row%(2) = 5: itemflag%(2) = 0
  101.         item$(3) = " ": itemlen%(3) = 10: inperr%(3) = 0: column%(3) = 64: row%(3) = 7: itemflag%(3) = 2
  102.         item$(4) = " ": itemlen%(4) = 6: inperr%(4) = 1: column%(4) = 45: row%(4) = 9: itemflag%(4) = 0      'inperr% = 1
  103.         item$(5) = entryload$: itemlen%(5) = 40: inperr%(5) = 0: column%(5) = 30: row%(5) = 11: itemflag%(5) = 0
  104.         item$(6) = " ": itemlen%(6) = 1: inperr%(6) = 0: column%(6) = 25: row%(6) = 13: itemflag%(6) = 0
  105.         item$(7) = " ": itemlen%(7) = 45: inperr%(7) = 0: column%(7) = 24: row%(7) = 15: itemflag%(7) = 0
  106.         item$(8) = " ": itemlen%(8) = 20: inperr%(8) = 0: column%(8) = 5: row%(8) = 17: itemflag%(8) = 0
  107.  
  108. CALL Fulledit(row%(), column%(), numentry%, inperr%(), item$(), itemlen%(), itemflag%())
  109.  
  110. CLS
  111.  
  112. REM *****************BACKGROUND PATTERN SECTION*****************
  113.  
  114. FOR row% = 1 TO 25
  115.     FOR column% = 1 TO 80
  116.         LOCATE row%, column%
  117.         COLOR sfg%, sbg%
  118.         PRINT CHR$(177);      'fill screen with background pattern
  119.     NEXT column%
  120. NEXT row%
  121.  
  122. REM ****************WINDOWS SECTION******************
  123.  
  124.     wintop% = 8             'initialize placement of window
  125.     winbot% = 21            '     "         "     "     "
  126.     winleft% = 10           '     "         "     "     "
  127.     winright% = 70          '     "         "     "     "
  128.  
  129.  
  130. DIM wintext$(winbot% - wintop% + 1)  'dimension array for lines of text
  131.  
  132.     REM wintext$(1) is a null string because the frame will cover it
  133.     wintext$(2) = Justify$("Results returned by Rosewood QB Stuff Input Editor", 2, winleft%, winright%)
  134.     wintext$(4) = "item$(1) = " + item$(1)
  135.     wintext$(5) = "item$(2) = " + item$(2)
  136.     wintext$(6) = "item$(3) = " + item$(3)
  137.     wintext$(7) = "item$(4) = " + item$(4)
  138.     wintext$(8) = Justify$("item$(5) = " + item$(5), 1, winleft%, winright%) 'see justify$ function
  139.     wintext$(9) = Justify$("item$(6) = " + item$(6), 0, winleft%, winright%)
  140.     wintext$(10) = "item$(7) = " + item$(7)
  141.     wintext$(11) = Justify$("item$(8) = " + item$(8), 0, winleft%, winright%)
  142.     wintext$(12) = ""
  143.     wintext$(13) = Justify$("Press any key to continue...", 2, winleft%, winright%)
  144.  
  145. CALL WindowSub(wintop%, winbot%, winleft%, winright%, 15, 4, wintext$(), 1)
  146.  
  147. REM ***********SECOND WINDOW**********
  148.  
  149. wintop% = 10
  150. winbot% = 22
  151. winleft% = 10
  152. winright% = 40
  153.  
  154. REDIM wintext$(winbot% - wintop% + 1)
  155.  
  156. FOR x% = 2 TO 6
  157.     wintext$(x%) = Justify$("Right Justified", 3, winleft%, winright%)
  158. NEXT x%
  159.  
  160. CALL WindowSub(wintop%, winbot%, winleft%, winright%, 15, 3, wintext$(), 0)
  161.  
  162. REM **********THIRD WINDOW**********
  163.  
  164. wintop% = 6
  165. winbot% = 11
  166. winleft% = 4
  167. winright% = 40
  168.  
  169. REDIM wintext$(winbot% - wintop% + 1)
  170. FOR x% = 2 TO 6
  171.     wintext$(x%) = Justify$("Centered Text", 2, winleft%, winright%)
  172. NEXT x%
  173. CALL WindowSub(wintop%, winbot%, winleft%, winright%, 15, 6, wintext$(), 1)
  174.  
  175. REM *********FOURTH WINDOW***********
  176.  
  177. wintop% = 13
  178. winbot% = 23
  179. winleft% = 10
  180. winright% = 70
  181.  
  182. REDIM wintext$(winbot% - wintop% + 1)
  183. wintext$(2) = Justify$("ROSEWOOD QUICKBASIC STUFF is brought to you by:", 2, winleft%, winright%)
  184. wintext$(3) = Justify$("Bert Christensen", 2, winleft%, winright%)
  185. wintext$(4) = Justify$("Rosewood Software", 2, winleft%, winright%)
  186. wintext$(5) = Justify$("135-10 Livonia Place", 2, winleft%, winright%)
  187. wintext$(6) = Justify$("Scarborough, Ontario M1E 4W6  Canada", 2, winleft%, winright%)
  188. wintext$(7) = Justify$("Telephone (416) 284-6119", 2, winleft%, winright%)
  189. wintext$(8) = Justify$("CompuServe 70461,2507  Internet bert.christensen@canrem.com", 2, winleft%, winright%)
  190. wintext$(10) = Justify$("Copyright (c) 1993", 2, winleft%, winright%)
  191. CALL WindowSub(wintop%, winbot%, winleft%, winright%, 15, 5, wintext$(), 1)
  192. COLOR sfg%, sbg%
  193.  
  194. END
  195.  
  196. SUB Frame (toprow%, bottomrow%, leftcol%, rightcol%)
  197.  
  198.         LOCATE toprow%, leftcol%: COLOR ffg%, fbg%: PRINT CHR$(201)  'top left corner
  199.         LOCATE toprow%, rightcol%: COLOR ffg%, fbg%: PRINT CHR$(187) 'top right corner
  200.         LOCATE bottomrow%, leftcol%: COLOR ffg%, fbg%: COLOR ffg%, fbg%: PRINT CHR$(200); 'bottom left corner
  201.         LOCATE bottomrow%, rightcol%: COLOR ffg%, fbg%: PRINT CHR$(188); 'bottom right corner
  202.  
  203.         FOR vertline% = toprow% + 1 TO bottomrow% - 1       'vertical lines
  204.                 LOCATE vertline%, leftcol%: COLOR ffg%, fbg%: PRINT CHR$(186);
  205.                 LOCATE vertline%, rightcol%: COLOR ffg%, fbg%: PRINT CHR$(186);
  206.         NEXT vertline%
  207.  
  208.                 horizlength% = rightcol% - leftcol% - 1     'horizontal lines
  209.                 horizline$ = STRING$(horizlength%, 205)
  210.         LOCATE toprow%, leftcol% + 1: COLOR ffg%, fbg%: PRINT horizline$
  211.         LOCATE bottomrow%, leftcol% + 1: COLOR ffg%, fbg%: PRINT horizline$;
  212.         LOCATE , , 0
  213. END SUB
  214.  
  215. SUB Fulledit (row%(), column%(), numentry%, inperr%(), item$(), itemlen%(), itemflag%())
  216.  
  217. 'there are some Wordstar type commands "scan% = 19 is Ctrl S". I hate Wordstar so I never completed all the commands.
  218.  
  219. LOCATE , , 0
  220. insertkey% = 0     'make typeover the default
  221. sc1% = 6           'cursor size for default typeover
  222. sc2% = 7
  223.         FOR menuitem% = 1 TO numentry%                  'make sure that existing entries have proper length
  224.                 IF LEN(item$(menuitem%)) < itemlen%(menuitem%) THEN
  225.                         item$(menuitem%) = item$(menuitem%) + STRING$((itemlen%(menuitem%) - LEN(item$(menuitem%))), " ") 'pad with spaces
  226.                 ELSEIF LEN(item$(menuitem%)) > itemlen%(menuitem%) THEN
  227.                         item$(menuitem%) = LEFT$(item$(menuitem%), itemlen%(menuitem%))  'truncate if necessary
  228.                 END IF
  229.         NEXT menuitem%
  230.         itemnum% = 1    'start a first input entry
  231.         FOR entry% = 1 TO numentry%                         'enter default data and/or spaces in proper places
  232.                 colm% = column%(entry%)
  233.                 FOR leng% = 1 TO itemlen%(entry%)
  234.                         COLOR rfg%, rbg%
  235.                         LOCATE row%(entry%), colm%
  236.                         defaultstr$ = MID$(item$(entry%), leng%, 1)
  237.                         PRINT defaultstr$;
  238.                         colm% = colm% + 1
  239.                 NEXT leng%
  240.         NEXT entry%
  241.         printcolumn% = column%(itemnum%)     'start at leftmost column
  242. ed1:    COLOR rfg%, rbg%: LOCATE row%(itemnum%), printcolumn%, 1, sc1%, sc2%                   'Place the cursor
  243.  
  244. ed2:    keypress$ = "": keypress$ = INKEY$: IF keypress$ = "" THEN GOTO ed2     'wait for keypress
  245.         scan% = ASC(keypress$)     'change keypress to integer
  246. ed4:
  247.         IF scan% = 27 THEN                'Esc
  248.                 IF inperr%(itemnum%) = 1 THEN  ' to prevent user from escaping from sub
  249.                         BEEP
  250.                 ELSE
  251.                         EXIT SUB
  252.                 END IF
  253.         END IF
  254.  
  255.         IF scan% > 31 AND scan% < 127 THEN           'Alphanum chars only
  256.                 DO
  257.                         SELECT CASE itemflag%(itemnum%)       'determine which set of characters are acceptable
  258.                                 CASE 0          'any alpha numeric
  259.                                 CASE 1          ' 0 to 9 and space
  260.                                         SELECT CASE scan%
  261.                                                 CASE 32, 48 TO 57   ' nothing to do. Let if "fall through" the SELECT CASE
  262.                                                 CASE ELSE
  263.                                                         BEEP
  264.                                                         GOTO ed2
  265.                                         END SELECT
  266.                                 CASE 2         '0 to 9, -,., space
  267.                                         SELECT CASE scan%
  268.                                                 CASE 32, 45, 46, 48 TO 57
  269.                                                 CASE ELSE
  270.                                                         BEEP
  271.                                                         GOTO ed2
  272.                                         END SELECT
  273.                         END SELECT
  274.  
  275.                 IF insertkey% = 0 THEN                     'typeover
  276.                         MID$(item$(itemnum%), printcolumn% - column%(itemnum%) + 1, 1) = keypress$
  277.                         PRINT keypress$;
  278.  
  279.                 ELSE
  280.                         item$(itemnum%) = LEFT$(LEFT$(item$(itemnum%), printcolumn% - column%(itemnum%)) + CHR$(scan%) + MID$(item$(itemnum%), printcolumn% - column%(itemnum%) + 1, column%(itemnum%)), itemlen%(itemnum%))           'insert
  281.                         LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%
  282.                         item$(itemnum%) = LEFT$(item$(itemnum%), itemlen%(itemnum%))
  283.                         PRINT item$(itemnum%);
  284.                 END IF
  285.                 scan% = 77                                   'move right 1 space
  286.                 EXIT DO
  287.                 LOOP
  288.         END IF
  289.  
  290.         IF scan% = 8 AND printcolumn% > column%(itemnum%) THEN          'Back Space
  291.                 printcolumn% = printcolumn% - 1
  292.                 LOCATE row%(itemnum%), printcolumn%, 1, sc1%, sc2%
  293.                 scan% = 83
  294.         END IF
  295.  
  296.         IF scan% = 0 THEN scan% = ASC(RIGHT$(keypress$, 1))             'Extended character
  297.  
  298.                                 ' scan% = 4 is the Wordstar Ctrl D
  299.         IF (scan% = 77 OR scan% = 4) AND printcolumn% < column%(itemnum%) - 1 + itemlen%(itemnum%) THEN     'Right arrow
  300.                 printcolumn% = printcolumn% + 1
  301.                 GOTO ed1
  302.         END IF
  303.                                  '19 = Ctrl S
  304.         IF (scan% = 75 OR scan% = 19) AND printcolumn% > column%(itemnum%) THEN          'Left arrow
  305.                 printcolumn% = printcolumn% - 1
  306.                 GOTO ed1
  307.         END IF
  308.  
  309.         IF scan% = 79 THEN                                  'end for    End of text
  310.                 IF LEN(RTRIM$(item$(itemnum%))) = 0 THEN
  311.                         printcolumn% = column%(itemnum%) + itemlen%(itemnum%) - 1
  312.                 ELSE
  313.                         printcolumn% = column%(itemnum%) + LEN(RTRIM$(item$(itemnum%)))
  314.                         IF printcolumn% > column%(itemnum%) + itemlen%(itemnum%) - 1 THEN printcolumn% = column%(itemnum%) + itemlen%(itemnum%) - 1
  315.                 END IF
  316.         GOTO ed1
  317.         END IF
  318.  
  319.         IF scan% = 99 THEN            'centre text on line
  320.  
  321.                 lenitm% = LEN(LTRIM$(RTRIM$(item$(itemnum%))))
  322.  
  323.                 item$(itemnum%) = SPACE$((itemlen%(itemnum%) - lenitm%) \ 2) + LTRIM$(RTRIM$(item$(itemnum%)))
  324.                 item$(itemnum%) = item$(itemnum%) + SPACE$(itemlen%(itemnum%) - LEN(item$(itemnum%)))
  325.                         LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%
  326.                         PRINT item$(itemnum%);
  327.  
  328.                 scan% = 80
  329.         END IF
  330.  
  331.  
  332.         IF scan% = 117 THEN                                   'ctrl +  end to go to end of line
  333.                 printcolumn% = column%(itemnum%) + itemlen%(itemnum%) - 1
  334.                 GOTO ed1
  335.         END IF
  336.  
  337.         IF scan% = 71 THEN                                  ' Home to beginning of text
  338.                 IF LEN(RTRIM$(item$(itemnum%))) = 0 THEN
  339.                         printcolumn% = column%(itemnum%)
  340.                 ELSE
  341.                         printcolumn% = column%(itemnum%) + ((itemlen%(itemnum%)) - (LEN(LTRIM$(item$(itemnum%)))))
  342.                         IF printcolumn% < column%(itemnum%) THEN printcolumn% = column%(itemnum%)
  343.                 END IF
  344.                 GOTO ed1
  345.         END IF
  346.  
  347.         IF scan% = 119 THEN                             'ctrl + home to start of line
  348.                 printcolumn% = column%(itemnum%)
  349.                 GOTO ed1
  350.         END IF
  351.  
  352.         IF (scan% = 80 OR scan% = 24) OR (scan% = 13 AND itemnum% <> numentry%) THEN  'Down Arrow  or Enter for next field
  353.  
  354.                 itemnum% = itemnum% + 1
  355.                         IF itemnum% > numentry% THEN itemnum% = numentry%
  356.                                 printcolumn% = column%(itemnum%)
  357.                                 GOTO ed1
  358.                         END IF
  359.       
  360.  
  361.         IF scan% = 81 THEN                             ' pgdn to last line
  362.                 itemnum% = numentry%
  363.                 printcolumn% = column%(itemnum%)
  364.                 GOTO ed1
  365.         END IF
  366.  
  367.         IF scan% = 72 OR scan% = 5 THEN                      'Up Arrow
  368.                 itemnum% = itemnum% - 1
  369.                 IF itemnum% < 1 THEN itemnum% = 1
  370.                 printcolumn% = column%(itemnum%)
  371.                 GOTO ed1
  372.         END IF
  373.  
  374.         IF scan% = 73 THEN                                 'pgup to top line
  375.                 itemnum% = 1
  376.                 printcolumn% = column%(itemnum%)
  377.                 GOTO ed1
  378.         END IF
  379.  
  380.         IF scan% = 83 THEN                                  'Delete
  381.                 item$(itemnum%) = LEFT$(item$(itemnum%), printcolumn% - column%(itemnum%)) + MID$(item$(itemnum%), printcolumn% - column%(itemnum%) + 2, itemlen%(itemnum%) - printcolumn% + column%(itemnum%) - 1) + " "
  382.                 LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%
  383.                 PRINT item$(itemnum%);
  384.                 GOTO ed1
  385.         END IF
  386.  
  387.  
  388.         IF scan% = 96 THEN                                  ' control f3 to delete line
  389.                 item$(itemnum%) = SPACE$(itemlen%(itemnum%))
  390.                 printcolumn% = column%(itemnum%)
  391.                 LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%
  392.                 PRINT item$(itemnum%);
  393.                 GOTO ed1
  394.         END IF
  395.  
  396.         IF scan% = 97 THEN                           'Ctrl F4 to copy
  397.                 cutline$ = item$(itemnum%)
  398.                 GOTO ed1
  399.         END IF
  400.  
  401.         IF scan% = 98 THEN                                   'Ctrl F5 to paste
  402.                 item$(itemnum%) = cutline$
  403.                 LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%
  404.                 PRINT LEFT$(item$(itemnum%), itemlen%(itemnum%));
  405.                 GOTO ed1
  406.         END IF
  407.  
  408.         IF scan% = 82 THEN                                     'insert toggle
  409.                 IF insertkey% = 0 THEN
  410.                         insertkey% = 1
  411.                         sc1% = 4       'change to 1/2 block cursor
  412.                         sc2% = 7
  413.                 ELSE
  414.                         insertkey% = 0
  415.                         sc1% = 6
  416.                         sc2% = 7
  417.                 END IF
  418.                 GOTO ed1
  419.          END IF
  420.  
  421.          IF scan% = 103 THEN         'ctrl f10 to exit
  422.                 scan% = 13
  423.          END IF
  424.       
  425. ed3:
  426.         IF scan% <> 13 THEN GOTO ed1
  427.  
  428.         FOR entry% = 1 TO numentry%                   'get rid of any ascii 0's
  429.         tempstring$ = ""
  430.                 FOR leng% = 1 TO LEN(item$(entry%))
  431.                         defaultstr$ = MID$(item$(entry%), leng%, 1)
  432.                         IF ASC(defaultstr$) = 0 THEN defaultstr$ = " "
  433.                         tempstring$ = tempstring$ + defaultstr$
  434.                 NEXT leng%
  435.         item$(entry%) = RTRIM$(tempstring$)
  436.         NEXT entry%
  437. LOCATE , , 0       'turn off cursor
  438. COLOR sfg%, sbg%
  439.  
  440. END SUB
  441.  
  442. FUNCTION Justify$ (text$, just%, winleft%, winright%)
  443. REM   function to justify text on a line within a window
  444. REM   text$ is the string to be modified
  445. REM   just% = one of the following
  446. REM   0 = not justiied
  447. REM   1 = left justified
  448. REM   2 = centre justified
  449. REM   3 = right justified
  450. REM   winleft% = the leftmost column of the window
  451. REM   winright% = the rightmost column of the window
  452.  
  453. SELECT CASE just%
  454.     CASE 0
  455.         'nothing needs to be done
  456.     CASE 1
  457.         text$ = LTRIM$(text$)    'delete leading spaces
  458.     CASE 2
  459.         centretext$ = LTRIM$(RTRIM$(text$))
  460.         IF LEN(centretext$) MOD 2 <> 0 THEN centretext$ = centretext$ + " "
  461.         lenitm% = LEN(centretext$) 'strip leading & trailing spaces and find length of remaining text
  462.         text$ = SPACE$(((winright% - winleft%) - lenitm%) \ 2) + centretext$  'add proper number of spaces to centre the text
  463.     CASE 3
  464.         lenitm% = LEN(LTRIM$(RTRIM$(text$))) 'find length of text with leading & trailing spaces deleted
  465.         text$ = SPACE$((winright% - winleft%) - (lenitm% + 1)) + LTRIM$(RTRIM$(text$)) 'add proper number of spaces before the text so that text is right justified
  466. END SELECT
  467.  
  468. Justify$ = text$  'change justify$ to modified string
  469.  
  470. END FUNCTION
  471.  
  472. SUB WindowSub (wintop%, winbot%, winleft%, winright%, winforecolour%, winbackcolour%, wintext$(), winborder%)
  473. REM     wintop% & winbot% are the top & bottom rows of the window
  474. REM     winleft% & winright% are the left & right coloumns of the window
  475. REM     fbg% 'window background colour
  476. REM     winforecolour% 'window foreground colour
  477. REM     wintext$() is an array containing the text of each line in the window
  478. REM     winborder% is a flag which signals the program to add a border(frame) around the window
  479. REM         0 = no border, 1 = border
  480.  
  481. fbg% = winbackcolour% 'window background colour
  482. ffg% = winforecolour% 'window foreground colour
  483.  
  484.         'set up 2 dimensional array to store characters "under" the window
  485.         DIM charascii%(wintop% TO winbot%, winleft% TO winright%)
  486.  
  487.         'same as above but to store color attributes
  488.         DIM charattrib%(wintop% TO winbot%, winleft% TO winright%)
  489.  
  490.         FOR winline% = wintop% TO winbot%
  491.             FOR wincolumn% = winleft% TO winright%
  492.                 charascii%(winline%, wincolumn%) = SCREEN(winline%, wincolumn%)     'fill character array
  493.                 charattrib%(winline%, wincolumn%) = SCREEN(winline%, wincolumn%, 1)  'fill attribute array
  494.             NEXT wincolumn%
  495.         NEXT winline%
  496.         
  497.             textline% = 1
  498.             FOR winline% = wintop% TO winbot%         'put in window filled with
  499.                 LOCATE winline%, winleft% + 1         'spaces of background colour
  500.                 COLOR winforecolour%, winbackcolour%
  501.                 PRINT SPACE$(winright% - winleft%);
  502.                 LOCATE winline%, winleft% + 1
  503.                 PRINT wintext$(textline%);            'print text in window
  504.                 textline% = textline% + 1
  505.             NEXT winline%
  506.  
  507.         IF winborder% = 1 THEN CALL Frame(wintop%, winbot%, winleft%, winright%)  'add fram if desired
  508.  
  509.         pause$ = INPUT$(1)    'pause ofter window is complete
  510.  
  511.         FOR winline% = wintop% TO winbot%               'delete window and replace
  512.            FOR wincolumn% = winleft% TO winright%       'original screen
  513.                 LOCATE winline%, wincolumn%
  514.                 COLOR charattrib%(winline%, wincolumn%) MOD 16, (charattrib%(winline%, wincolumn%) AND &H70) \ 16  'parse stored colour attributes to foreground and background
  515.                 PRINT CHR$(charascii%(winline%, wincolumn%))   'print stored characters
  516.             NEXT wincolumn%
  517.         NEXT winline%
  518.  
  519. ERASE wintext$         'get the arrays out of memory
  520. ERASE charascii%
  521. ERASE charattrib%
  522.  
  523. END SUB
  524.  
  525.